home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / toolssrc / Deplex.lex < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.2 KB  |  188 lines  |  [TEXT/R*ch]
  1. {
  2.   
  3. open Deppars Config;
  4.  
  5. (* For nesting comments *)
  6.  
  7. val comment_depth = ref 0;
  8.  
  9. (* The table of keywords *)
  10.  
  11. val keyword_table = (Hasht.new 53 : (string,token) Hasht.t);
  12.  
  13. val () =
  14. List.app (fn (str,tok) => Hasht.insert keyword_table str tok)
  15. [
  16.   ("abstype",    NULL),
  17.   ("and",        NULL),
  18.   ("andalso",    NULL),
  19.   ("as",         NULL),
  20.   ("case",       NULL),
  21.   ("datatype",   NULL),
  22.   ("do",         NULL),
  23.   ("else",       NULL),
  24.   ("eqtype",     NULL),
  25.   ("end",        NULL),
  26.   ("exception",  NULL),
  27.   ("fn",         NULL),
  28.   ("fun",        NULL),
  29.   ("handle",     NULL),
  30.   ("if",         NULL),
  31.   ("in",         NULL),
  32.   ("infix",      NULL),
  33.   ("infixr",     NULL),
  34.   ("let",        NULL),
  35.   ("local",      NULL),
  36.   ("nonfix",     NULL),
  37.   ("of",         NULL),
  38.   ("op",         NULL),
  39.   ("open",       OPEN),
  40.   ("orelse",     NULL),
  41.   ("prim_eqtype",  NULL),
  42.   ("prim_EQtype",  NULL),
  43.   ("prim_type",    NULL),
  44.   ("prim_val",     NULL),
  45.   ("raise",      NULL),
  46.   ("rec",        NULL),
  47.   ("then",       NULL),
  48.   ("type",       NULL),
  49.   ("val",        NULL),
  50.   ("while",      NULL),
  51.   ("with",       NULL),
  52.   ("withtype",   NULL),
  53.   ("#",          NULL),
  54.   ("->",         NULL),
  55.   ("|",          NULL),
  56.   (":",          NULL),
  57.   ("=>",         NULL),
  58.   ("=",          NULL),
  59.   ("*",          NULL)
  60. ];
  61.  
  62. fun mkKeyword lexbuf =
  63.   let val s = getLexeme lexbuf in
  64.     Hasht.find keyword_table s
  65.     handle Subscript => ID s
  66.   end
  67. ;
  68.  
  69. val savedLexemeStart = ref 0;
  70.  
  71. fun getQual s =
  72.   let open CharVector
  73.       val len' = size s - 1
  74.       fun parse n =
  75.         if n >= len' then
  76.         ""                (* This can't happen *)
  77.         else if sub(s, n) = #"." then
  78.         extract(s, 0, SOME n)
  79.         else
  80.         parse (n+1)
  81.   in parse 0 end;
  82.  
  83. fun mkQualId lexbuf =
  84.   QUAL_ID (getQual(getLexeme lexbuf));
  85.  
  86. fun lexError msg lexbuf = NULL;
  87.  
  88. fun incr r = (r := !r + 1);
  89. fun decr r = (r := !r - 1);
  90.  
  91. }
  92.  
  93. rule Token = parse
  94.     [^ `\000`-`\255`]
  95.       { lexError "this will be never called!" lexbuf }
  96.   | ""
  97.       {TokenN lexbuf}
  98. and TokenN = parse
  99.     [` ` `\n` `\r` `\t`]  { TokenN lexbuf }
  100.   | "(*"
  101.       { savedLexemeStart := getLexemeStart lexbuf;
  102.         comment_depth := 1; Comment lexbuf; TokenN lexbuf
  103.       }
  104.   | "*)"
  105.       { lexError "unmatched comment bracket" lexbuf }
  106.   | "'" [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]+
  107.                 { NULL }
  108.   | "~"? [`0`-`9`]+ (`.` [`0`-`9`]+)? (`E` `~`? [`0`-`9`]+)?
  109.                 { NULL }
  110.   | "\""
  111.       { String lexbuf }
  112.   | "#\""
  113.       { String lexbuf }
  114.   | "_"         { NULL }
  115.   | ","         { NULL }
  116.   | "..."       { NULL }
  117.   | "{"         { NULL }
  118.   | "}"         { NULL }
  119.   | "["         { NULL }
  120.   | "#["        { NULL }
  121.   | "]"         { NULL }
  122.   | "("        { NULL }
  123.   | ")"        { NULL }
  124.   | ";"         { NULL }
  125.   | (eof | `\^Z`) { EOF }
  126.   | ""          { TokenId lexbuf }
  127.  
  128. and TokenId = parse
  129.     ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
  130.     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
  131.        `~` `\`` `^` `|` `*`]+ )
  132.       { mkKeyword lexbuf }
  133.   | ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
  134.     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
  135.        `~` `\`` `^` `|` `*`]+ )
  136.     "."
  137.     ( [`A`-`Z` `a`-`z`] [ `A`-`Z` `a`-`z` `0`-`9` `_` `'`]*
  138.     | [`!` `%` `&` `$` `#` `+` `-` `/` `:` `<` `=` `>` `?` `@` `\\`
  139.        `~` `\`` `^` `|` `*`]+ )
  140.       { mkQualId lexbuf }
  141.   | _
  142.       { lexError "ill-formed token" lexbuf }
  143.  
  144. and Comment = parse
  145.     "(*"
  146.       { (incr comment_depth; Comment lexbuf) }
  147.   | "*)"
  148.       { (decr comment_depth;
  149.          if !comment_depth > 0 then Comment lexbuf else NULL) }
  150.   | (eof | `\^Z`)
  151.       { EOF }
  152.   | _
  153.       { Comment lexbuf }
  154.  
  155. and String = parse
  156.     `"`
  157.       { NULL }
  158.   | `\\` [`\\` `"` `n` `t`]
  159.       { String lexbuf }
  160.   | `\\` [` ` `\t` `\n` `\r`]+ `\\`
  161.       { String lexbuf }
  162.   | `\\` `^` [`@`-`_`]
  163.       { String lexbuf }
  164.   | `\\` [`0`-`9`] [`0`-`9`] [`0`-`9`]
  165.       { String lexbuf }
  166.   | `\\`
  167.       { SkipString lexbuf }
  168.   | (eof | `\^Z`)
  169.       { EOF }
  170.   | [`\^A`-`\^Z` `\127` `\255`]
  171.       { SkipString lexbuf }
  172.   | _
  173.       { String lexbuf }
  174.  
  175. and SkipString = parse
  176.     `"`
  177.       { NULL }
  178.   | `\\` [`\\` `"` `n` `t`]
  179.       { SkipString lexbuf }
  180.   | `\\` [` ` `\t` `\n` `\r`]+ `\\`
  181.       { SkipString lexbuf }
  182.   | (eof | `\^Z`)
  183.       { EOF }
  184.   | _
  185.       { SkipString lexbuf }
  186.  
  187. ;
  188.